home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qpshell-command-ring.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  2.9 KB  |  86 lines
  1. ;;; SCCS: @(#)89/11/20 qpshell-command-ring.el    1.2
  2. ;;; Source not known
  3. ;;;
  4.  
  5. (provide 'shell-command-ring)
  6.  
  7. (defvar command-ring nil
  8.   "List of previously typed shell commands.")
  9.  
  10. (defconst command-ring-max 30
  11.   "*Maximum length of kill ring before oldest elements are thrown away.")
  12.  
  13. (defvar command-ring-yank-pointer nil
  14.   "The tail of the kill ring whose car is the last thing yanked.")
  15.  
  16. (fset 'command-ring-save 'save-command-in-ring)
  17.  
  18. (defun save-command-in-ring (beg end)
  19.   "Save the region as if killed, but don't kill it."
  20.   (interactive "r")
  21.   (let ((command-string (buffer-substring beg end)))
  22.     (if (and (> (length command-string) 2)
  23.              (not (string-equal command-string (car command-ring))))
  24.         (progn
  25.           (setq command-ring (cons command-string command-ring))
  26.           (if (> (length command-ring) command-ring-max)
  27.               (setcdr (nthcdr (1- command-ring-max) command-ring) nil))
  28.           (setq this-command 'save-command-in-ring)
  29.           (setq command-ring-yank-pointer command-ring)))))
  30.  
  31. (defun rotate-command-yank-pointer (arg)
  32.   "Rotate the yanking point in the command ring."
  33.   (interactive "p")
  34.   (let ((length (length command-ring)))
  35.     (if (zerop length)
  36.     (error "Command ring is empty")
  37.       (setq command-ring-yank-pointer
  38.         (nthcdr (% (+ arg (- length (length command-ring-yank-pointer)))
  39.                length)
  40.             command-ring)))))
  41.  
  42. (defun command-pop (arg)
  43.   "Replace just-yanked shell input with a different input.
  44. This command is allowed only immediately after a  yank  or a  yank-pop.
  45. At such a time, the region contains a stretch of reinserted
  46. previously-killed text.  yank-pop  deletes that text and inserts in its
  47. place a different stretch of killed text.
  48.  
  49. With no argument, the previous kill is inserted.
  50. With argument n, the n'th previous kill is inserted.
  51. If n is negative, this is a more recent kill.
  52.  
  53. The sequence of kills wraps around, so that after the oldest one
  54. comes the newest one."
  55.   (interactive "*p")
  56.   (if (not (eq last-command 'copy-last-shell-input))
  57.       (error "Previous command was not a yank"))
  58.   (setq this-command 'copy-last-shell-input)
  59.   (let ((before (< (point) (mark))))
  60.     (delete-region (point) (mark))
  61.     (rotate-command-yank-pointer arg)
  62.     (set-mark (point))
  63.     (insert (car command-ring-yank-pointer))
  64.     (delete-char -1)
  65.     (if before (exchange-point-and-mark))))
  66.  
  67. (defun copy-last-shell-input (&optional arg)
  68.   "Reinsert the last stretch of killed text.
  69. More precisely, reinsert the stretch of killed text most recently
  70. killed OR yanked.
  71. With just C-U as argument, same but put point in front (and mark at end).
  72. With argument n, reinsert the nth most recently killed stretch of killed
  73. text.
  74. See also the command \\[yank-pop]."
  75.   (interactive "*P")
  76.   (rotate-command-yank-pointer (if (listp arg) 0
  77.              (if (eq arg '-) -1
  78.                (1- arg))))
  79.   (push-mark (point))
  80.   (insert (car command-ring-yank-pointer))
  81.   (delete-char -1)
  82.   (if (consp arg)
  83.       (exchange-point-and-mark)))
  84.  
  85.  
  86.